home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / PARSEX.ICN < prev    next >
Text File  |  1992-09-28  |  4KB  |  164 lines
  1. ############################################################################
  2. #
  3. #    File:     parsex.icn
  4. #
  5. #    Subject:  Program to parse arithmetic expressions
  6. #
  7. #    Author:   Cheyenne Wills
  8. #
  9. #    Date:     June 10, 1988
  10. #
  11. ###########################################################################
  12. #
  13. #  Adapted from C code written by Allen I. Holub published in the
  14. #  Feb 1987 issue of Dr. Dobb's Journal.
  15. #
  16. #  General purpose expression analyzer.  Can evaluate any expression
  17. #  consisting of number and the following operators (listed according
  18. #  to precedence level):
  19. #
  20. #  () - ! 'str'str'
  21. #  * / &
  22. #  + -
  23. #  < <= > >= == !=
  24. #  && ||
  25. #
  26. # All operators associate left to right unless () are present.
  27. # The top - is a unary minus.
  28. #
  29. #
  30. #  <expr>   ::= <term> <expr1>
  31. #  <expr1>  ::= && <term> <expr1>
  32. #        ::= || <term> <expr1>
  33. #        ::= epsilon
  34. #
  35. #  <term>   ::= <fact> <term1>
  36. #  <term1>  ::= <  <fact> <term1>
  37. #        ::= <= <fact> <term1>
  38. #        ::= >  <fact> <term1>
  39. #        ::= >= <fact> <term1>
  40. #        ::= == <fact> <term1>
  41. #        ::= != <fact> <term1>
  42. #        ::= epsilon
  43. #
  44. #  <fact>   ::= <part> <fact1>
  45. #  <fact1>  ::= + <part> <fact1>
  46. #        ::= - <part> <fact1>
  47. #        ::= - <part> <fact1>
  48. #        ::= epsilon
  49. #
  50. #  <part>   ::= <const> <part1>
  51. #  <part1>  ::= * <const> <part1>
  52. #        ::= / <const> <part1>
  53. #        ::= % <const> <part1>
  54. #        ::= epsilon
  55. #
  56. #  <const>  ::= ( <expr> )
  57. #        ::= - ( <expr> )
  58. #        ::= - <const>
  59. #        ::= ! <const>
  60. #        ::= 's1's2'    # compares s1 with s2  0 if ~= else 1
  61. #        ::= NUMBER       # number is a lose term any('0123456789.Ee')
  62. #
  63. #############################################################################
  64.  
  65. procedure main()
  66.    local line
  67.  
  68.    writes("->")
  69.    while line := read() do {
  70.        write(parse(line))
  71.        writes("->")
  72.        }
  73. end
  74.  
  75. procedure parse(exp)
  76.    return exp ? expr()
  77. end
  78.  
  79. procedure expr(exp)
  80.    local lvalue
  81.  
  82.    lvalue := term()
  83.    repeat {
  84.        tab(many(' \t'))
  85.        if ="&&" then lvalue := iand(term(),lvalue)
  86.        else if ="||" then lvalue := ior(term(),lvalue)
  87.        else break
  88.        }
  89.    return lvalue
  90. end
  91.  
  92. procedure term()
  93.    local lvalue
  94.  
  95.    lvalue := fact()
  96.    repeat {
  97.        tab(many(' \t'))
  98.        if      ="<=" then lvalue := if lvalue <= fact() then 1 else 0
  99.        else if ="<"  then lvalue := if lvalue <  fact() then 1 else 0
  100.        else if =">=" then lvalue := if lvalue >= fact() then 1 else 0
  101.        else if =">"  then lvalue := if lvalue >  fact() then 1 else 0
  102.        else if ="==" then lvalue := if lvalue =  fact() then 1 else 0
  103.        else if ="!=" then lvalue := if lvalue ~= fact() then 1 else 0
  104.        else break
  105.        }
  106.    return lvalue
  107. end
  108.  
  109. procedure fact()
  110.    local lvalue
  111.  
  112.    lvalue := part()
  113.    repeat {
  114.        tab(many(' \t'))
  115.        if ="+" then lvalue +:= part()
  116.        else if ="-" then lvalue -:= part()
  117.        else break
  118.        }
  119.    return lvalue
  120. end
  121.  
  122. procedure part()
  123.    local lvalue
  124.  
  125.    lvalue := const()
  126.    repeat {
  127.        tab(many(' \t'))
  128.        if ="*" then lvalue *:= part()
  129.        else if ="%" then lvalue %:= part()
  130.        else if ="/" then lvalue /:= part()
  131.        else break
  132.        }
  133.    return lvalue
  134. end
  135.  
  136. procedure const()
  137.    local sign, logical, rval, s1, s2
  138.  
  139.    tab(many(' \t'))
  140.  
  141.    if ="-" then sign := -1 else sign := 1
  142.    if ="!" then logical := 1 else logical := &null
  143.    if ="(" then {
  144.        rval := expr()
  145.        if not match(")") then {
  146.        write(&subject)
  147.        write(right("",&pos-1,"_"),"^ Mis-matched parenthesis")
  148.        }
  149.        else move(1)
  150.        }
  151.    else if ="'" then {
  152.        s1 := tab(upto('\''))
  153.        move(1)
  154.        s2 := tab(upto('\''))
  155.        move(1)
  156.        rval := if s1 === s2 then 1 else 0
  157.        }
  158.    else {
  159.        rval := tab(many('0123456789.eE'))
  160.        }
  161.    if \logical then { return if rval = 0 then 1 else 0 }
  162.    else return rval * sign
  163. end
  164.